perm filename NTS.F4[P11,LCS] blob sn#583812 filedate 1981-05-02 generic text, type T, neo UTF8
	SUBROUTINE NTS
	COMMON /STF/RSTFAC(0/7),RSTJ2 /WIDTH/WID1,WID2
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
	COMMON /POSI/STFF(0/7),JJ2,POS
C  ITEMS IN FOLLOWING COMMON BLOCK ARE USED IN 'TAILS' AND 'FERM'
	COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
	1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,RZTM,RXX,JJJ,
	1 PUNCT,JY,RJ
	EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R4,RJQ(2))
	1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8)),
 	1(J11,JQ(9)),(J6,JQ(4)),(R5,RJQ(3)),(R11,RJQ(9)),(JSTEM,JQ(20))
 	1,(R8,RJQ(6)),(R7,RJQ(5)),(RJZ,RJQ(20)),(R3,RJQ(1))
 	1,(RX4,JQ(19)),(R12,RJQ(10))

	DATA WID1/14.54/,WID2/16.2/
C  NOTES****
	JSTEM=J5/10
	JY=IABS(J6)
	IF(JY.EQ.30)JY=0
C   30 IS USED IN NOTBMS & RHYTH.
	IF(R11.EQ.0)GO TO 10
C SORT IT OUT IN NTSB
	R6=-1.
	GO TO 1
10	IF(R6.EQ.0)GO TO 1
	R6=ABS(AMOD(R6,1.0))*10.
C R6 WILL HAVE ACCENT CODE # (.7=DOT, ETC.)
1	L=IABS(J4)
	RJAC=R3
C    TO SAVE POS. OF NOTE FOR ACCENT
	RZTM=2.*RSTJ2
1010	IF(J10.LE.0)GO TO 1110
	POS=STFF(J2-3+2*J10)
C  FOR PUTTING NOTES ON STAFF ABOVE OR BELOW. J10=1=DOWN, =2=UP
	CALL CENTX
1110	 IF(L.LT.80)GO TO 1013
C MINIS= 80→179  OR -100→-120
	IF(L.LT.180)GO TO 1012
C DIAMOND NTS=180→279
	RZTM=0
	IF(L.GE.280)GO TO 1014
C X NTS=280→379
	KL=8
	RG=12.0
C   FOR DIAMOND NOTES.
	GO TO 1013

C 	STEM ONLY NTS=380→479
1014	IF(L.GE.380)GO TO 1016
	RJX=RMINI*7.
C  FOR "X" NOTES
	KL=13
	 RG=16.
	RB=RJX
	IF(JSTEM.EQ.2)RB=-RB
	RB=RB+CENTR
	GO TO 1013

1016	IF(L.GE.10000)GO TO 1013
1019	IF(L.GE.480)GO TO 1017
	RB=CENTR+R12*RST7
C +400 = NO NOTE HEAD.  P12 CAN ADJUST SOURCE OF STEM.
	GO TO 1013
1017	CALL EXTRA
C  GO USE SPECIAL NOTE PACKAGE
	RETURN
C 'EXTRA' IS FOR USER-ADDED NOTE AND REST SHAPES. P4+ 480→ (OR 600 TOO?)
C  480 IS USED SO NOTES CAN BE AT 500-19
1012	RMINI=.6*RSTJ2
C  FOR RMINI NOTES, MINI TAILS AND ACCIS. ETC.
1013	J4=R4
	RX4=R4
	RJZ=R4
C  RJZ FOR FLAT, #, NAT.   RX4 FOR TR., HARM, ETC.
	IF(JY.LT.10)GO TO 2221
	RQ=WID1
	IF(L.GE.180)GO TO 2
	IF(J6.LT.0)RQ=WID2
C  WHITE NOTE WIDTH=WID2
C P6 FOR HOMING TO RIGHT(10) OR LEFT(20) OF STEM(10=UP, 20=DOWN)
C P6<0 = WHITE NOTE   GETS WIDTH OF NOTE DISPLACEMENT
2	IF(JY.EQ.20)RQ=-RQ
	R3=R3+RQ*RMINI
2221	IF(J4.LE.1)GO TO 322
	IF(J4.LT.13)GO TO 1121
322	IF(J9.NE.-1)CALL NTS4
C NTS4 MAKES LEDGER LINES.   J9=-1 SUPRESSES THEM.
C  J9<-1 MAKES LEDGER LINES, BUT WILL NOT JUSTIFY.
1121	IF(L.LT.380)CALL NTS5
	CALL NTS2
	END